perm filename S1.F4[M11,LCS] blob
sn#404802 filedate 1978-12-17 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 C THIS PROGRAM IS THE PROPERTY OF LELAND SMITH, PROFESSOR OF MUSIC
C00009 ENDMK
Cā;
C THIS PROGRAM IS THE PROPERTY OF LELAND SMITH, PROFESSOR OF MUSIC
C AT STANFORD UNIVERSITY. IT MAY NOT BE COPIED OR ALTERED IN ANY
C WAY WITHOUT WRITTEN PERMISSION OF THE AUTHOR.
C 3/78 ********** SCORE FOR PDP11 ********** LELAND SMITH
C THIS PROGRAM WRITES NOTE LISTS FOR THE PDP11 SOUND
C GENERATION PROGRAM. (MUSIC 5 TYPE)
C IF # OF INSTS IS CHANGED, ALSO CHANGE # IN 'INFO'('HELP') FORMAT.
C LOAD 'S1' WITH S2,S3,SCANR AND SPRINT
C (AND QUAD AND QUADO WHEN THEY ARE READY) AND
C IF DESIRED, A SUBROUTINE WITH THE FOLLOWING HEADING:
C SUBROUTINE SUBR
C COMMON /INS/ INST(27),BG(60)
C COMMON P(30),INUM,IPAR,CNT(27),BT,PL(48),IREST,DF,DUR(27)
C INUM=INST# IPAR=PARAM#
C BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
C IF IREST IS <0, THAT NOTE WILL BE A REST.
C INST=INST. NAME, BG=INSTS' BEGIN TIMES.
C NOTE #S IN SUBROUTINE: (1-84) C4=37 FS4=43 C5=49 ETC.
C F1=86 F15=100 (NO F16!)
COMMON /Q/ BNW(100),NWZ /INS/INST(27),BG(60) /TYP/SOS,JOUT,
1 LN,ITYP,TPALN(4),JED /SAM/ISAM
C SEE LABEL 1774 AND BELOW RE. BUFFER LIMIT.
COMMON/VV/LIMIT,V(2000) /A/ROFF(27),NP(27),PCH(27,32),
1 RDEV(27),IPT(27,31),XT(27),OTH(20,16)
1 ,P1(27),COPY(30),IFM(80)
1 ,INVIS(27)
DIMENSION LIST(78),JNP(80)
C WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY
C 40 LIT CHARS + 30 PARAMS PER INST.
C 60 BG TIMES AVAILABLE. FOR INSTS AND INSERTS AND EDITS.
COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
1/E/IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
1 ,INP(144),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
COMMON/B/MOT,PR,T5,NINS,I,TP,RA,KZY,NWX,INONLY,MX,
1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
1 ZZ,CHN,YY
1 /D/TF,AMPFAC,OP1,DURX,IXIN,JFLNM
1 /C/LPAR,IPRN,QX,IRTRO,INVRT,ICON,LCNT,
1 IPAREN,JZ,BY,MLX,IZ,ALL,JD,LEND,QTS,ITMP,
1 LP,ILIT,NLIT,KTMP,IC,RAX,RD,IA
C /C/=26
C11 DOUBLE PRECISION IFLNM,INNM,ITP,IEDT,ITPD,JBLA
EQUIVALENCE (LIST,IFM(3)),(JNP,INP)
DATA KZY/27/,ISEMI/';'/,IQT/'"'/,LIMIT/2000/
C IAA=A ID=D IE=E IF=F IEN=N IPP=P ISS=S ITT=T
DATA IBLA/' '/,IXX/'X'/,JBLA/' '/,ITP/'TYPE'/
1 ,IDAT/'0','1','2','3','4','5','6','7','8','9','.'/
1 ,ISCA/'C','P','D','O','E','F','PX','G','S','A','T','B'/
CCC PLAY??? 1 ,ISCA/'C','P','D','O','E','F','PLAY;','G','S','A','T','B'/
LPAR=0
IPRN=0
QX=0.
MOT=0
IRTRO=-1
INVRT=-1
ICON=-1
LCNT=1
IPAREN=0
JZ=1
IAMP=0
C IAMP IS 'BLANK LINE'FLAG ON PP1-3.
T5=0
NINS=0
K=0
IDALL=-1
QTS=-1.
KB=0
NWZ=1
BNW(1)=0
I=1
KL=0
TP=0
RA=0
CHN=0
DO 127 K=1,77,3
127 LIST(K)=0
C INITIALIZES MOTIVIC LIST FOR ERROR FINDING ROUTINE.
NWX=0
BY=-1
DO 1128 K=1,KZY
INVIS(K)=0
INST(K)=0
CNT(K)=0
RDEV(K)=0
C RDEV IS FOR RAND DEVIATIONS AT RUN TIME
NP(K)=0
IQ(K)=0
IPT(K,1)=0
DO 1128 L=1,32
1128 PCH(K,L)=0
ITYP=-1
JED=-1
2112 TYPE 8002
ACCEPT 8001,INNM,J
C**** INNM AND IFLNM SHOULD DBL PREC. ON PDP11 (FOR A4 FORMAT)
C**** ONLY UP TO 4 LETTERS IN FILE NAMES.
999 IF(INNM.NE.IEDT)GO TO 3112
JED=0
GO TO 2112
C 'EDIT' GOES TO EDIT MODE
3112 IF(INNM.NE.ITP)GO TO 128
ITYP=0
IFLNM=ITPD
C***************** OPEN AN OUTPUT FILE *********
C11 CALL OPEN(21,IFLNM,0,'NEW',,,'UNF')
CALL OFILE(21,IFLNM)
CALL READIT
C******* IS A5 AVAILABLE?? *************
8001 FORMAT(A4,I)
8002 FORMAT(' TYPE FILE NAME-- '$)
128 IF(INNM.NE.JBLA)IFLNM=INNM
C*********** OPEN AN INPUT FILE ******************
C11 CALL OPEN(23,IFLNM,0,'RDO')
CALL IFILE (23,IFLNM)
SOS=-1
IF(J.NE.0)SOS=0
C TYPE ANY NUMBER AFTER INPUT FILE NAME TO SUPRESS INPUT LISTING.
C11 CALL OPEN(1,'RUNIT',0,'NEW',,,'UNF')
C**** THIS WRITES A FILE NAMED 'RUNIT.DAT' ********
CALL OFILE(1,'RUNIT')
CALL READIT
END